home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / p4 / p4-1_2c.lha / p4-1.2c / contrib_f / norm_master.f < prev    next >
Text File  |  1993-05-24  |  5KB  |  172 lines
  1.       program m1
  2.  
  3.       include 'p4f.h'
  4.  
  5. *-----
  6. *  file:-  norm_master.f
  7. *  related files:-  
  8. *    norm_slave.f         (slave program)
  9. *    norm_<hostname>.pg   (process group file)
  10. *
  11. *  Test program for new p4 library.
  12. *    Generate matrix,
  13. *    distribute columns to slaves,
  14. *    get sum norm of columns, verify and display result.
  15. *
  16. *  features:-
  17. *    max vector length <= `NMAX'.  If you increase this value,
  18. *            be sure to increase the same value in slave program, too.
  19. *    4 data byte per integer (controlled by `LENINT')
  20. *    4 data byte per item    (real; controlled by `LENREAL')
  21. *  
  22. *  Debug code disabled by `c$$$'.
  23. *  status:- plain vanilla, no error control
  24. *  Volker Kurz, ANL & U Frankfurt, 04-Oct-91
  25. *-----
  26. *     .. p4 routines ..
  27.       external   p4init, p4crpg, p4ntotids, p4send, p4recv, p4cleanup,
  28.      $     p4clock
  29. *
  30. *     .. constants ..
  31.       integer    NMAX,      LENINT,   LENREAL,   OFF
  32.       parameter (NMAX=200 , LENINT=4, LENREAL=4, OFF=-1)
  33.       integer    TAGCNT,    TAGDAT,    TAGNEW,    TAGEND
  34.       parameter (TAGCNT=10, TAGDAT=20, TAGNEW=30, TAGEND=40)
  35. *
  36. *     .. variables and arrays ..
  37.       integer    nslaves, i, k, mnsl, time1, time2,
  38.      $     iretcd, ireclen, ip, msglen, itype
  39.       real       a(NMAX, NMAX), r(NMAX), rnorm
  40.       logical    errors
  41. *-----
  42. *
  43.       write (*,*) 'setting up parallel environment...'
  44. *
  45.       call p4init ()
  46.       call p4crpg ()
  47.       nslaves = p4ntotids() - 1
  48. *
  49.       write (*,*) 'initializing matrix...'
  50. *
  51.       do 1 k=1,NMAX
  52.          a(1,k) = float (k+1)
  53.          do 11 i=2,NMAX
  54.             a(i,k) = 1.0
  55.  11      continue
  56.  1    continue
  57. *-----------------------------------------------------------------------
  58. *  Beginning of main loop
  59. *  ~~~~~~~~~~~~~~~~~~~~~~
  60.  2    continue
  61. *
  62. *  Ask for number of rows and columns.
  63. *  Provide a condition to end the program.
  64. *  Watch out, if they want to fool us by entering too big numbers.
  65. *  Calculate message length for slave data.
  66. *  Broadcast vector length to slaves.
  67. *
  68.       write (*,9993) NMAX
  69.       read (*,*) m
  70.       if (m.lt.1) then
  71.          goto 7
  72.       elseif (m.gt.NMAX) then
  73.          m = NMAX
  74.          write (*,*) 'value truncated to m = ',m
  75.       endif
  76.       write (*,9995) NMAX
  77.       read (*,*) n
  78.       if (n.lt.1) then
  79.          goto 7
  80.       elseif (n.gt.NMAX) then
  81.          n = NMAX
  82.          write (*,*) 'value truncated to n = ',n
  83.       endif
  84. *
  85.       msglen = m * LENREAL
  86.       time1 = p4clock()
  87. *
  88.       do 3 i=1,nslaves
  89.          call p4send (TAGCNT, i, m, LENINT, iretcd)
  90.  3    continue
  91. *
  92. *  Compute norms of columns
  93. *  ~~~~~~~~~~~~~~~~~~~~~~~~
  94. *  Process columns by strips of length 'nslaves'.
  95. *  'mnsl' ensures that only 'n' columns are processed.
  96. *  1st sweep dials out columns,
  97. *  2nd sweep collects results.
  98. *  
  99.       do 4 i=1,n,nslaves
  100. *        .. distribute columns to slaves ..
  101.          mnsl = min ( n-i+1, nslaves ) 
  102.          do 41 k=1,mnsl
  103. *           .. send column i+k-1 to slave k ..
  104.             call p4send (TAGDAT, k, a(1,i+k-1), msglen, iretcd)
  105.  41      continue
  106.          do 42 k=1,mnsl
  107. *           .. receive norm from slave ..
  108.             itype = TAGDAT
  109.             ip = OFF
  110.             call p4recv (itype, ip, rnorm, LENREAL, ireclen, iretcd)
  111. *           .. result is for column i+ip-1 ..
  112.             r(i+ip-1) = rnorm
  113.  42      continue
  114.  4    continue 
  115.       time2 = p4clock()
  116. *
  117. *  Check results and report any errors.  
  118. *  Norm of column k is:  #rows + k
  119. *  Note: There should be no rounding errors!
  120. *
  121.       errors = .FALSE.
  122.       do 5 k=1,n
  123.          if (r(k).ne.m+k) then
  124.             write (*,9999) k, m+k, r(k)
  125.             errors = .TRUE.
  126.          endif
  127. c$$$         write (*,*) 'norm of col', k,' is:', r(k)
  128.  5    continue
  129.       if (errors) then
  130.          write (*,*) 'mission completed, error(s) detected.'
  131.       else
  132.          write (*,*) 'mission completed, no errors detected.'
  133.       endif
  134.       write (*,9997) float (time2-time1) / 1000.0
  135. *
  136. *  Tell slaves to get ready for a new session.
  137. *  Data is ignored, when slave detects data type TAGNEW.
  138. *
  139.       do 6 i=1,nslaves
  140.          call p4send (TAGNEW, i, m, LENINT, iretcd)
  141.  6    continue
  142. *
  143. *  End of main loop
  144. *  ~~~~~~~~~~~~~~~~
  145.       goto 2
  146.  7    continue
  147. *------------------------------------------------------------------------------
  148. *
  149. *  Terminate parallel session
  150. *  ~~~~~~~~~~~~~~~~~~~~~~~~~~
  151. *  Broadcast TAGEND signal to all slaves.
  152. *  A slave will terminate, when TAGEND is detected,
  153. *  the contents of the message will be ignored.
  154. *
  155.       do 8 i=1,nslaves
  156.          call p4send (TAGEND, i, n, LENINT, iretcd)
  157.  8    continue
  158.       call p4cleanup
  159. *-----
  160.       stop
  161.  9993 format(1x,'-----'/
  162.      $     ' input number of rows (1 <= m <=',i7,')'/
  163.      $     ' (any value <= 0 terminates program)')
  164.  9995 format(1x,
  165.      $     ' input number of columns (1 <= n <=',i7,')'/
  166.      $     ' (any value <= 0 terminates program)')
  167.  9997 format(1x,'time :',f12.3,' s')
  168.  9999 format(1x,'Error in column ',i7/
  169.      $     '   norm should be       :',i10/
  170.      $     '   but computed value is:',e14.4)
  171.       end
  172.